home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Toolbox Classes / CtlWind < prev    next >
Text File  |  1993-06-23  |  3KB  |  93 lines
  1. \ 1.3.88    rfl    A window that will not scroll. This preserves the fprect
  2. \                used by fwind for scrolling.
  3. \ 11.25.90    rfl    added close: feature to nonScrollWind. This means that
  4. \                if selected and the window was from a resource, then
  5. \                the global window position will be saved in the resource,
  6. \                but the resource will not save to disk. Note that this
  7. \                defaults to window's close method.
  8. \  4.20.91    rfl    fixed close: so that if rsrc not found, rect isn't left on stack
  9. \ 10.26.91    rfl    eliminated nonscrollwind...now savewind
  10. \  1.17.91  rfl    added getnew to make the wind rsrc non purgeable if saveposition=true
  11. \  6.22.93    rfl    changed ctlhit? to handle sys 7 popup menus
  12.  
  13. create nopurge popA0 " HNoPurge" asmcall next,
  14.  
  15. :CLASS rsrcWind <super window
  16.  
  17.     int    savePosition
  18.  
  19.     :M SAVEPOSITION: put: savePosition ;M
  20.  
  21.     :M GETNEW: getnew: super get: savePosition IF get: resID getres WIND nopurge THEN ;M
  22.  
  23. \ if the window was brought up from a resource, then save the last position
  24. \  of the window in the resource, but don't save.
  25.     :M CLOSE: get: savePosition
  26.         IF set: self 0 l->g unpack     \ get global corner
  27.             getRect: self put: tempRect
  28.             offset: tempRect
  29.             get: resID getres WIND -dup                     \ is there a resource?
  30.             IF >r  get: tempRect r> >ptr put: rect THEN        \ ok, so save the window coordinates
  31.         THEN
  32.         close: super ;M
  33.  
  34. ;CLASS
  35.  
  36.  
  37. \ ctlWind - Window subclass adding controls
  38. \ 12/15/84  cbd Version 1
  39. \  9/04/86  ghs Fixed draw: -do draw: super first so controls are not erased
  40. \ 12/04/87    rfl note that ' ctlproc is correct
  41. \  1/03/87    rfl    super nonScrollWind
  42. Decimal
  43.  
  44. \ ( part# ctlHndl -- )  execute action for control
  45. : ctlExec    exec: [ get-ctl-obj ]  ;
  46.  
  47. \ procedure to be executed when a control is being tracked.
  48. \  ( ctlHndl int:part -- )
  49. :proc  ctlProc  word0 swap ctlExec  ;proc
  50. ' ctlProc value ctp
  51.  
  52. initprocs
  53.  
  54. \ Look for control click
  55. : ctlHit? { wind \ part mpoint ^ctl action1 action2 -- bool }
  56.     where: fEvent g->l -> mpoint    \ save mouse loc
  57.     Word0  mpoint wind +base
  58.     theCtl +base    call FindControl
  59.     word0 -> part  theCtl @ -> ^ctl    \ ctl handle
  60.     part inThumb = part inCheckBox = or  part inButton = or part 1 = or
  61.     IF  'c ctlExec -> action2    \ only exec after release
  62.         part 1 = IF -1 ELSE 0 THEN ->  action1 
  63.     ELSE   ctp +base -> action1
  64.         'c 2drop -> action2
  65.     THEN  ^ctl
  66.     IF word0  ^ctl  mpoint action1
  67.         call TrackControl word0
  68.         ^ctl exec> action2 true
  69.     ELSE false
  70.     THEN ;
  71.  
  72. \ Note: if your Window is a subclass of CtlWind and has scroll bars,
  73. \ it should set the scroll bars to 255 hiliting on a deactivate event.
  74. \ This can be done via the Disable: method in VScroll.
  75. :CLASS  CtlWind  <Super rsrcWind
  76.  
  77.     \ draw the window with controls
  78.     :M  DRAW:   draw: super  (abs) call DrawControls   ;M
  79.  
  80.     \ dispose of window's controls and close the window
  81.     :M  CLOSE:  (abs) call KillControls  close: super  ;M
  82.  
  83.     \ handle a content click
  84.     :M  CONTENT:  active: self
  85.         IF  ^base ctlHit?  not
  86.             IF  exec: content THEN
  87.         ELSE  (abs) call SelectWindow
  88.         THEN
  89.     ;M
  90.  
  91. ;CLASS
  92.  
  93.